home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / eos / sun-eos-debugger-extra.el < prev    next >
Encoding:
Text File  |  1995-08-22  |  24.2 KB  |  857 lines
  1. ;;; sun-eos-debugger.el --- Implements the XEmacs/SPARCworks Debugger interface
  2.  
  3. ;; Copyright (C) 21 Aug 1995  Sun Microsystems, Inc.
  4.  
  5. ;; Maintainer:    Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
  6. ;; Author:      Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
  7. ;; Version:    1.26
  8. ;; Header:    @(#) sun-eos-debugger-extra.el: v1.26 95/08/22 10:11:02
  9.  
  10. ;; Keywords:    SPARCworks EOS Era on SPARCworks Debugger dbx
  11.  
  12. ;;; Commentary:
  13. ;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
  14.  
  15. ;;; Code:
  16.  
  17. ;; debugger buffer
  18.  
  19. (require 'eos-common   "sun-eos-common")
  20. (require 'eos-debugger "sun-eos-debugger")
  21. (require 'eos-menubar  "sun-eos-menubar")
  22.  
  23. (defvar eos::debugger-buffer "*Eos Debugger Log*"
  24.   "name of buffer where to log debugger activity; see eos::use-debugger-buffer")
  25. (defvar eos::dbx-buffer nil)
  26. (defvar eos::key-mode 'none "Style of key mode interaction for Eos")
  27.  
  28. (defun eos::ensure-debugger-buffer ()
  29.   ;; will ensure a debugger buffer, with the proper major mode
  30.   (let ((buf (get-buffer eos::debugger-buffer)))
  31.     (if buf
  32.     (switch-to-buffer buf)
  33.       (setq buf (get-buffer-create eos::debugger-buffer))
  34.       (set-buffer buf)
  35.       (eos::debugger-mode)
  36.       (toggle-read-only -1)        ; writeable
  37.       (eos::insert-string-as-extent "[Debugger] " t (get-face 'bold))
  38.       (toggle-read-only 1)        ; read-only
  39.       )))
  40.  
  41. (defun eos::synchronize-debugger-buffer ()
  42.   ;; ensure all views of this buffer are at the end
  43.   (eos::ensure-debugger-buffer)
  44.   (let ((x (point-max)))
  45.     (goto-char x)
  46.     (mapcar (function
  47.          (lambda (win)
  48.            (set-window-point win x)))
  49.         (get-buffer-window-list eos::debugger-buffer))
  50.     ))
  51.  
  52. (defvar eos::debugger-mode-map nil)
  53.  
  54. (if eos::debugger-mode-map
  55.     nil
  56.   (progn
  57.     (setq eos::debugger-mode-map (make-keymap))
  58.     (set-keymap-name eos::debugger-mode-map 'eos::debugger-mode-map)
  59.     (define-key eos::debugger-mode-map [(meta p)] 'eos::debugger-previous-cmd)
  60.     (define-key eos::debugger-mode-map [(meta n)] 'eos::debugger-next-cmd)
  61.     (define-key eos::debugger-mode-map [return] 'eos::debugger-send-cmd)
  62.     ))
  63.  
  64. (defun eos::debugger-mode ()
  65.   (interactive)
  66.   "local mode"
  67.   (kill-all-local-variables)    
  68.   (setq major-mode 'eos::debugger-mode)
  69.   (setq mode-name "eos::debugger")
  70.   (setq truncate-lines t)
  71.   (set-syntax-table emacs-lisp-mode-syntax-table)
  72.   (use-local-map eos::debugger-mode-map))
  73.  
  74.  
  75. ;; Handling of command lists
  76.  
  77. (defvar eos::current-command nil "Current command navigated; as an extent")
  78. (defvar eos::last-command nil "last command sent to debugger, as an extent")
  79.  
  80. (defun eos::debugger-previous-cmd ()
  81.   ;; present the previous command
  82.   (interactive)
  83.   (save-excursion
  84.     (let ((xt nil))
  85.       (if (null eos::current-command)
  86.       (setq xt eos::last-command)
  87.     (setq xt (extent-property 
  88.           eos::current-command
  89.           'previous-command)))
  90.       (if xt
  91.       (progn
  92.         (eos::debugger-delete-last-cmd-line)
  93.         (goto-char (point-max))
  94.         (insert (buffer-substring
  95.              (extent-start-position xt)
  96.              (1- (extent-end-position xt)) ; remove <CR>
  97.              ))
  98.         (setq eos::current-command xt))
  99.     (error "no previous command")
  100.     ))
  101.     ))
  102.  
  103. (defun eos::debugger-next-cmd ()
  104.   ;; present the next command
  105.   (interactive)
  106.   (save-excursion
  107.     (let ((xt nil))
  108.       (if (null eos::current-command)
  109.       (error "no next command")
  110.     (setq xt (extent-property 
  111.           eos::current-command
  112.           'next-command)))
  113.       (eos::debugger-delete-last-cmd-line)
  114.       (if xt
  115.       (progn
  116.         (goto-char (point-max))
  117.         (insert (buffer-substring
  118.              (extent-start-position xt)
  119.              (1- (extent-end-position xt)) ; remove <CR>
  120.              ))
  121.         (setq eos::current-command xt))
  122.     (setq eos::current-command nil)
  123.     ))
  124.     ))
  125.  
  126. (defun eos::debugger-delete-last-cmd-line ()
  127.   ;; delete the last command line, not yet inputed, returns that cmd line
  128.   (goto-char (point-max))
  129.   (let ((e (point)))
  130.     (beginning-of-line)
  131.     (let* ((xt (extent-at (point)))
  132.        (p (extent-end-position xt))
  133.        (str (buffer-substring p e))
  134.        )
  135.       (delete-region p e)
  136.       str
  137.       )))
  138.  
  139. (defun eos::debugger-send-cmd ()
  140.   ;; send the message in the current line
  141.   (interactive)
  142.   (end-of-line)
  143.   (let ((e (point)))
  144.     (beginning-of-line)
  145.     (let* ((xt (extent-at (point)))
  146.        (p (extent-end-position xt))
  147.        (str (buffer-substring p e))
  148.        )
  149.       (delete-region p e)
  150.       (eos::send-spider-current-do-msg (concat str "\n"))
  151.       (goto-char (point-max))
  152.       (setq eos::current-command nil)
  153.       )))
  154.  
  155. ;; client
  156. ;;
  157.  
  158. (defun get-buffer-window-list (buffer)
  159.   ;; like get-buffer-window except that will generate a list of windows
  160.   ;; instead of just the first one"
  161.   (let* ((buf (get-buffer buffer))
  162.      (win1 (next-window nil 'foo t t))
  163.      (win win1)
  164.      (first t)
  165.      (ret nil)
  166.      )
  167.     (if (null buf)
  168.     nil
  169.       (while (or
  170.           (and first win)
  171.           (not (or first (equal win win1)))
  172.           )
  173.     (setq first nil)
  174.     (if (equal
  175.          buf
  176.          (window-buffer win))
  177.         (setq ret (cons win ret)))
  178.     (setq win (next-window win t t t))
  179.     )
  180.       ret)))
  181.  
  182. (defun eos::dbx-process ()
  183.   ;; Returns nil, or the corresponding process where to insert
  184.   (let ((pl (process-list))
  185.     (found-proc nil)
  186.     )
  187.     (while (and pl (null found-proc))
  188.       (let* ((proc (car pl))
  189.          (name (process-name proc))
  190.          )
  191.     (if (and (>= (length name) 3)
  192.          (equal (substring name 0 3) "Eos"))
  193.         (setq found-proc proc)
  194.       (setq pl (cdr pl))
  195.       )
  196.     ))
  197.     found-proc
  198.     ))
  199.  
  200. (defun eos::insert-echo (process string)
  201.   (if (null process)
  202.       nil
  203.     (save-excursion
  204.       (set-buffer (process-buffer process))
  205.       (goto-char (point-max))
  206. ;;      (let ((beg (point)))
  207. ;;    (insert-before-markers string))
  208.       (insert-before-markers string)
  209.       (if (process-mark process)
  210.       (set-marker (process-mark process) (point-max))))
  211.     (if (eq (process-buffer process)
  212.         (current-buffer))
  213.     (goto-char (point-max)))
  214.     ))
  215.  
  216.  
  217. (defun eos::insert-on-debugger-buffer (msg rdonly face &optional previous-command)
  218.   ;; will insert MSG at end of debugger buffer with RDONLY property and with FACE. 
  219.   ;; If PREVIOUS-COMMAND is given, the newly created extent will be doubly linked into this one
  220.   ;; using 'previous-command and 'next-command properties
  221.   (save-window-excursion
  222.   (let ((fr (selected-frame))
  223.     (buf (current-buffer))
  224.     (xt nil))
  225.     (eos::ensure-debugger-buffer)
  226.     (toggle-read-only -1)        ; not read-only 
  227.     (eos::insert-echo (eos::dbx-process) msg)
  228.     (setq xt (eos::insert-string-as-extent msg rdonly face))
  229.     (if previous-command
  230.     (progn
  231.       (set-extent-property xt 'previous-command previous-command)
  232.       (set-extent-property previous-command 'next-command xt)
  233.       ))
  234.     (toggle-read-only 1)        ; now read-only 
  235.     (switch-to-buffer buf)
  236.     (select-frame fr)
  237.     xt
  238.   ))
  239.   )
  240.  
  241. (defun eos::insert-string-as-extent (msg rdonly face)
  242.   ;; insert MSG as a extent with RDONLY and FACE.  Returns the extent
  243.   (let ((here nil)
  244.     (xt nil))
  245.     (goto-char (point-max))
  246.     (setq here (point))
  247.     (insert msg)
  248.     (setq xt (make-extent here (point) nil))
  249.     (if rdonly
  250.     (progn
  251.       (set-extent-property xt 'read-only t)
  252.       (set-extent-property xt 'duplicable nil)
  253.       ))
  254.     (set-extent-face xt face)
  255.     (eos::synchronize-debugger-buffer)
  256.     xt
  257.     ))
  258.  
  259.  
  260. (require 'comint)
  261.  
  262. (defvar eos::dbx-program "dbx")
  263. (defvar eos::dbx-switches (list "-editor"))
  264.  
  265. (defun eos::expand-file-name (file)
  266.   ;; expand file name depending on first character
  267.   (cond
  268.    ((null file)
  269.     nil)
  270.    ((eq (elt file 0) ?~)
  271.     (expand-file-name file))
  272.    ((eq (elt file 0) ?$)
  273.     (substitute-in-file-name file))
  274.    (t file)))
  275.  
  276. (defun eos::read-dbx-request (program switches)
  277.   ;; will prompt to the user with PROGRAM and SWITCHES, let her modify this
  278.   ;; and then will read the result and split it into program and switches.
  279.   (let* ((prompt
  280.       (concat program " " (mapconcat 'identity switches " ")))
  281.      (ret (read-from-minibuffer "Run dbx as: " prompt))
  282.      (ret2 (split-string ret " ")))
  283.     ;; some testing
  284.     (cons (car ret2) (cdr ret2))
  285.   ))
  286.  
  287. (defun eos::dbx ()
  288. ;; Run an inferior dbx -editor process, with I/O through buffer *Eos Dbx*.
  289. ;; If buffer exists but dbx process is not running, make new dbx.
  290. ;; If buffer exists and dbx process is running, 
  291. ;; just switch to buffer `*Eos Dbx*'.
  292.   (let ((buffer "*Eos Dbx*")
  293.     (buffer-name "Eos Dbx")
  294.     (input nil))
  295.     (cond ((not (comint-check-proc buffer))
  296.        (setq input (eos::read-dbx-request eos::dbx-program
  297.                           eos::dbx-switches))
  298.        (setq eos::dbx-program (car input))
  299.        (setq eos::dbx-switches (cdr input))
  300.        (message "Starting Dbx subprocess")
  301.        (setq buffer
  302.          (set-buffer
  303.           (apply 'make-comint 
  304.              buffer-name
  305.              (eos::expand-file-name eos::dbx-program)
  306.              nil
  307.              (mapcar 'eos::expand-file-name eos::dbx-switches))))
  308.        (comint-mode)
  309.        (if (and (eq (device-type (frame-device (selected-frame))) 'tty)
  310.             (eq eos::key-mode 'none)
  311.             (yes-or-no-p 
  312.              "Do you want the prefix map activated?"))
  313.            (eos::set-key-mode 'prefix))
  314.        (setq eos::dbx-or-debugger 'dbx)
  315.        (setq eos::dbx-buffer (current-buffer))
  316.        (make-local-variable 'kill-buffer-hook)
  317.        (setq kill-buffer-hook
  318.          (list (function (lambda ()
  319.                    (cond
  320.                     ((null (eos::dbx-process)) t)
  321.                     ((not (eq (process-status (eos::dbx-process)) 'run)) t)
  322.                     ((yes-or-no-p
  323.                       "Warning! Killing this buffer will kill a dbx process, proceed? ")
  324.                      (eos::internal-clear-annotations t t t t))
  325.                     (t (error "kill-buffer aborted!")))
  326.                    ))))
  327.        )
  328.       (t
  329.        (message "Reusing existing dbx buffer and dbx process")))
  330.     (switch-to-buffer buffer)
  331.   ))
  332.  
  333.  
  334. ;; Actions to start a debugger in the background.
  335.  
  336. (defvar eos::debugger-process nil
  337.   "Debugger process for the background.  Only one per XEmacs")
  338.  
  339. (defvar eos::dbx-or-debugger nil)
  340.  
  341. (defun eos::start-debugger ()
  342.   "Start an \"debugger -editor\" in the background. Will ask for confirmation if
  343. XEmacs somehow believes there is already one running"
  344.   (interactive)
  345.   (if (and (or (not (processp eos::debugger-process))
  346.            (not (eq (process-status eos::debugger-process) 'run))
  347.            (yes-or-no-p
  348.         "Warning! XEmacs believes there already is a debugger -editor, proceed? "))
  349.        (or (not (eos::dbx-process))
  350.            (not (eq (process-status (eos::dbx-process)) 'run))
  351.            (yes-or-no-p
  352.         "Warning! XEmacs believes there already is a dbx -editor, proceed? ")))
  353.       (progn
  354.     (setq eos::debugger-process
  355.           (start-process "*eos debugger*" nil "debugger" "-editor"))
  356.     (message "Starting Debugger subprocess")
  357.     (eos::select-debugger-frame (selected-frame))
  358.     (setq eos::dbx-or-debugger 'debugger)
  359.     )))
  360.  
  361. ;; Ditto for dbx.
  362.  
  363. (defun eos::start-dbx ()
  364.   "Start an \"dbx -editor\" as a subprocess. Will ask for confirmation if
  365. XEmacs somehow believes there is already one running"
  366.   (interactive)
  367.   (if (and (or (not (processp eos::debugger-process))
  368.            (not (eq (process-status eos::debugger-process) 'run))
  369.            (yes-or-no-p
  370.         "Warning! XEmacs believes there already is a debugger -editor, proceed? "))
  371.        (or (not (eos::dbx-process))
  372.            (not (eq (process-status (eos::dbx-process)) 'run))
  373.            (yes-or-no-p
  374.         "Warning! XEmacs believes there already is a dbx -editor, proceed? ")))
  375.       (progn
  376.     (eos::select-debugger-frame (selected-frame))
  377.     (eos::dbx)
  378.     )))
  379.  
  380.  
  381. ;;
  382. ;; Communication commands
  383. ;;
  384.  
  385. (defun eos::spider-do-callback (msg pat)
  386.   ;; Callback after processing a spider_do request
  387.   (eos::insert-on-debugger-buffer
  388.    (format "%s" (get-tooltalk-message-attribute msg 'arg_val 2))
  389.    t
  390.    (get-face 'bold))
  391.   (destroy-tooltalk-message msg)
  392.   )
  393.  
  394. (defvar eos::last-command-was-print nil "(eos:: internal)")
  395.  
  396. (defun eos::spro_spider_output (msg pat)
  397.   ;; For spider output
  398.   (let ((s (get-tooltalk-message-attribute msg 'arg_val 1))
  399.     (err (get-tooltalk-message-attribute msg 'arg_val 2))
  400.     )
  401.     (message (format "%s" s))
  402.     (eos::insert-on-debugger-buffer (format "%s" s)
  403.                     t
  404.                     (get-face 'default))
  405.     (if (and err (not (string-equal err "")))
  406.     (eos::insert-on-debugger-buffer
  407.      (insert (format "STDERR> %s" err))
  408.      t
  409.      (get-face 'default))
  410.       )
  411.     (destroy-tooltalk-message msg)))
  412.  
  413. (defun eos::spro_spider_output-common (msg pat)
  414.   ;; For spider output
  415.   (if eos::last-command-was-print
  416.       (eos::spro_spider_print_output msg pat)
  417.     (eos::spro_spider_output msg pat)))
  418.  
  419. (defmacro eos::spider-tt-args (cmd spider-id clique-id)
  420.   (` (list
  421.       'class TT_REQUEST
  422.       'address TT_HANDLER
  423.       'scope TT_SESSION
  424.       'handler (, spider-id)
  425.       'op "SPRO_SPIDER_DO"
  426.       'callback 'eos::spider-do-callback
  427.       'args (list
  428.          (list 'TT_IN (, clique-id) "Context_ID")
  429.          (list 'TT_IN (, cmd) "string")
  430.          (list 'TT_OUT))
  431.       )))
  432.  
  433. (defun eos::send-spider-do-msg (cmd spider-id clique-id)
  434.   ;; Send CMD, a string, to SPIDER-ID, using CLIQUE-ID
  435.   (let ((msg (make-tooltalk-message
  436.           (eos::spider-tt-args cmd spider-id clique-id))))
  437.     (setq eos::last-command
  438.       (eos::insert-on-debugger-buffer
  439.        cmd
  440.        t
  441.        (get-face 'italic)
  442.        eos::last-command))
  443.     (setq eos::current-command eos::last-command)
  444.     (send-tooltalk-message msg)
  445.     (destroy-tooltalk-message msg)
  446.     ))
  447.  
  448. (defvar eos::no-connection-box
  449.       '("XEmacs does not know the ID of a debugger to connect to.
  450. You may need to reissue a debug or attach command from the debugger.
  451. Consult the introduction to Eos (Help->SPARCworks...) for more details."
  452.            ["Dismiss" (message "Command aborted") t]))
  453.  
  454. (defun eos::send-spider-current-do-msg (cmd)
  455.   ;; Send CMD to the current dbx engine using the current debugger clique;
  456.   ;;The cmd ends in a new-line.
  457.   (if (null eos::current-debugger-clique-id)
  458.       (popup-dialog-box eos::no-connection-box)
  459.     (eos::send-spider-do-msg cmd
  460.                  eos::current-dbx-proc-id
  461.                  eos::current-debugger-clique-id)))
  462.  
  463. (defun eos::dbx-cmd (arg) 
  464.   "Send CMD to the current dbx engine using the current debugger clique;
  465. The cmd does not end in a new-line; a new-line will be added"
  466.   (interactive "sDbx cmd: ")
  467.   (eos::send-spider-current-do-msg (concat arg "\n")))
  468.  
  469.  
  470. ;;
  471. ;; Extra patterns
  472.  
  473. (defvar eos::dbx-extra-pattern-list nil)
  474.  
  475. (defun eos::debugger-extra-startup ()
  476.   ;; Actions to do at startup for eos-debugger-extra.el
  477.     (setq eos::dbx-extra-pattern-list    ; list of extra TT patterns
  478.       (eos::create-debugger-extra-patterns))
  479.     (eos::ensure-available-print-frame)
  480.     (eos::define-prefix-map)        ; initialize keymap
  481.   )
  482.  
  483. (defun eos::create-debugger-extra-patterns ()
  484.   ;; returns a list of patterns
  485.   (list
  486.    (make-an-observer "SPRO_SPIDER_OUTPUT" 'eos::spro_spider_output-common)
  487.    ))
  488.  
  489. (defun eos::register-debugger-extra-patterns ()
  490.   ;; register additional dbx patterns
  491.     (mapcar 'register-tooltalk-pattern eos::dbx-extra-pattern-list))
  492.  
  493. (defun eos::unregister-debugger-extra-patterns ()
  494.   ;; unregister additional dbx patterns
  495.   (mapcar 'unregister-tooltalk-pattern eos::dbx-extra-pattern-list))
  496.  
  497. ;;
  498. ;; Common commands
  499. ;;
  500.  
  501.  
  502. (defun eos::type () (interactive)
  503.   (if (eq eos::dbx-or-debugger 'debugger)
  504.       (call-interactively 'eos::dbx-cmd)
  505.     (if (buffer-live-p eos::dbx-buffer)
  506.     (switch-to-buffer eos::dbx-buffer)
  507.       (message "no dbx subprocess buffer known"))))
  508.  
  509. (defun eos::run () (interactive) (eos::dbx-cmd "run"))
  510. (defun eos::fix () (interactive) (eos::dbx-cmd "fix"))
  511. (defun eos::build () (interactive) (eos::dbx-cmd "make"))
  512.  
  513. (defun eos::cont () (interactive) (eos::dbx-cmd "cont"))
  514. (defun eos::cont-and-dismiss () (interactive)
  515.   (eos::dismiss-print-frame) (eos::cont))
  516. (defun eos::clear-all () (interactive) (eos::dbx-cmd "clear"))
  517. (defun eos::next () (interactive) (eos::dbx-cmd "next"))
  518. (defun eos::next-and-dismiss () (interactive)
  519.   (eos::dismiss-print-frame) (eos::next))
  520. (defun eos::step () (interactive) (eos::dbx-cmd "step"))
  521. (defun eos::step-and-dismiss () (interactive)
  522.   (eos::dismiss-print-frame) (eos::step))
  523. (defun eos::step-up () (interactive) (eos::dbx-cmd "step up"))
  524.  
  525. (defun eos::up () (interactive)  (eos::dbx-cmd "up" ))
  526. (defun eos::down () (interactive) (eos::dbx-cmd "down"))
  527. (defun eos::pop () (interactive) (eos::dbx-cmd "pop"))
  528.  
  529.  
  530. (defun eos::stop-at ()
  531.   (interactive)
  532.   (let ((name (buffer-file-name)))
  533.     (if (null name) (error "Buffer has no associated file"))
  534.     (eos::dbx-cmd
  535.      (format "stop at \"%s\":%d" name (eos::line-at (point))))
  536.     ))
  537.  
  538. (defun eos::clear-at ()
  539.   (interactive)
  540.   (let ((name (buffer-file-name)))
  541.     (if (null name) (error "Buffer has no associated file"))
  542.     (eos::dbx-cmd
  543.      (format "clear \"%s\":%d" name (eos::line-at (point))))
  544.      ))
  545.  
  546. (defun eos::stop-in ()
  547.   (interactive)
  548.   (eos::dbx-cmd
  549.    (format "stop in %s"
  550.        (if (eq 'x (device-type (selected-device)))
  551.            (x-get-selection)
  552.          (buffer-substring (point) (mark)))
  553.        ))
  554.    (setq zmacs-region-stays t))
  555.  
  556. (defun eos::func ()
  557.   (interactive)
  558.   (eos::dbx-cmd
  559.    (format "func %s"
  560.        (if (eq 'x (device-type (selected-device)))
  561.            (x-get-selection)
  562.          (buffer-substring (point) (mark)))
  563.        ))
  564.   (setq zmacs-region-stays t))
  565.  
  566. (defun eos::cont-to ()
  567.   (interactive)
  568.   (let ((name (buffer-file-name)))
  569.     (if (null name) (error "Buffer has no associated file"))
  570.     (eos::dbx-cmd
  571.      (format "stop at \"%s\":%d -temp; cont" name (eos::line-at (point))))
  572.     ))
  573.  
  574. (defun eos::print-normal ()
  575.   (interactive)
  576.   (eos::dbx-cmd
  577.    (format "print  %s"
  578.        (if (eq 'x (device-type (selected-device)))
  579.            (x-get-selection)
  580.          (buffer-substring (point) (mark)))
  581.        ))
  582.   (setq zmacs-region-stays t))
  583.  
  584. (defun eos::print*-normal ()
  585.   (interactive)
  586.   (eos::dbx-cmd
  587.    (format "print  *(%s)"
  588.        (if (eq 'x (device-type (selected-device)))
  589.            (x-get-selection)
  590.          (buffer-substring (point) (mark)))
  591.        ))
  592.   (setq zmacs-region-stays t))
  593.  
  594. ;; specialization for print commands
  595.  
  596. (defun eos::send-spider-print-msg (expr)
  597.   ;; Print EXPR using separate frame
  598.   (setq eos::last-command-was-print t)
  599.   (eos::dbx-cmd (format "print %s" expr)))
  600.  
  601. (defun eos::send-spider-print*-msg (expr)
  602.   ;; Send *EXPR using separate frame
  603.   (setq eos::last-command-was-print t)
  604.   (eos::dbx-cmd (format "print *(%s)" expr)))
  605.  
  606. (defun eos::print () (interactive)
  607.  (eos::send-spider-print-msg
  608.   (if (eq 'x (device-type (selected-device)))
  609.       (x-get-selection)
  610.     (buffer-substring (point) (mark)))
  611.   )
  612.  (setq zmacs-region-stays t))
  613.  
  614. (defun eos::print* () (interactive)
  615.  (eos::send-spider-print*-msg
  616.   (if (eq 'x (device-type (selected-device)))
  617.       (x-get-selection)
  618.     (buffer-substring (point) (mark)))
  619.   )
  620.  (setq zmacs-region-stays t))
  621.  
  622.  
  623. ;;
  624. ;;
  625. ;; Print on separate frame
  626.  
  627.  
  628. (defun eos::buffer-line-size (buffer)
  629.   (interactive)
  630.   (or (bufferp buffer)
  631.       (setq buffer (current-buffer)))
  632.   (save-excursion
  633.     (switch-to-buffer buffer)
  634.     (eos::line-at (point-max))))
  635.  
  636. ;;
  637. ;; Handling of a collection of print frames
  638. ;; (currently only one)
  639.  
  640. (defvar eos::print-frame nil "Frame for prints")
  641. (defvar eos::print-buffer " *Eos Print Output*" "Buffer for prints")
  642.  
  643. (defun eos::new-available-print-frame()
  644.   ;; returns an available print frame
  645.   ;; currently just returns the one frame
  646.   (require 'eos-toolbar  "sun-eos-toolbar")
  647.   (let ((scr (selected-frame))
  648.     (buf (current-buffer)))
  649.  
  650.     ;; create frames
  651.     (if (and 
  652.      (frame-live-p eos::print-frame)
  653.      (or (not (frame-live-p eos::debugger-frame))
  654.          (not (eq eos::print-frame
  655.               eos::debugger-frame))))
  656.     (progn
  657.       (make-frame-visible eos::print-frame)
  658.       eos::print-frame)
  659.       (setq eos::print-frame (make-frame))
  660.       ;; no modeline visible...
  661.       (set-face-background 'modeline 
  662.                (face-background (get-face 'default))
  663.                eos::print-frame)
  664.       (set-face-foreground 'modeline 
  665.                (face-background (get-face 'default))
  666.                eos::print-frame)
  667.       ;; there is redundancy below.
  668.       (select-frame eos::print-frame)
  669.       (switch-to-buffer eos::print-buffer)
  670.       (set-buffer-menubar nil)
  671.       (add-spec-to-specifier (eos::toolbar-position) eos::print-toolbar (selected-frame))
  672.       (add-spec-to-specifier has-modeline-p nil (selected-frame))
  673.       (select-frame scr)
  674.       (switch-to-buffer buf)
  675.       eos::print-frame
  676.       )))
  677.  
  678. ;; set delete-frame-hook and check for this frame... then do 
  679.  
  680.  
  681.  
  682. (defun eos::ensure-available-print-frame ()
  683.   ;; ensures that there is at least one available print frame
  684.   t)
  685.  
  686. (defun eos::show-print-frame ()
  687.   (interactive)
  688.   (setq eos::print-frame (eos::new-available-print-frame))
  689.   (select-frame eos::print-frame)
  690.   (switch-to-buffer eos::print-buffer)
  691.   (set-frame-height eos::print-frame
  692.              (+ 1 (eos::buffer-line-size eos::print-buffer)))
  693.   (goto-char (point-min))
  694.     )
  695.  
  696. (defun eos::dismiss-print-frame ()
  697.   (interactive)
  698.   (if (frame-live-p eos::print-frame)
  699.       (progn
  700.     (make-frame-invisible eos::print-frame)
  701.     (select-frame (car (visible-frame-list))))))
  702. ;;
  703. ;; print output
  704. ;;
  705.  
  706. (defun eos::spro_spider_print_output (msg pat)
  707.   ;; For spider print output (switched with spro_spider_output
  708.   (let ((buf (current-buffer))
  709.     (scr (selected-frame)))
  710.     (save-excursion            ; does not work in callbacks?
  711.       (switch-to-buffer eos::print-buffer)
  712.       (delete-region (point-min) (point-max))
  713.       (goto-char (point-max))
  714.       (insert (format "%s" (get-tooltalk-message-attribute msg
  715.                                'arg_val 1)))
  716.       (let ((err (get-tooltalk-message-attribute msg
  717.                          'arg_val 2)))
  718.     (if (and err (not (string-equal err "")))
  719.         (insert (format "STDERR> %s" err))))
  720.       (eos::show-print-frame)
  721.       (select-frame scr)
  722.       (switch-to-buffer buf)
  723.       )
  724.     (destroy-tooltalk-message msg)
  725.     (setq eos::last-command-was-print nil)
  726.     ))
  727.  
  728.  
  729. ;; User interface
  730.  
  731. (defvar eos::prefix-map (make-keymap))
  732.  
  733. (defun eos::define-prefix-map ()
  734.  
  735.   (define-key eos::prefix-map "%" 'eos::dbx-cmd)
  736.   (define-key eos::prefix-map "r" 'eos::run)
  737.   (define-key eos::prefix-map "f" 'eos::fix)
  738.  
  739.   (define-key eos::prefix-map "p" 'eos::print)
  740.   (define-key eos::prefix-map "\C-p" 'eos::print*)
  741.  
  742.   (define-key eos::prefix-map "c" 'eos::cont)
  743.   (define-key eos::prefix-map "b" 'eos::stop-at)
  744.   (define-key eos::prefix-map "\C-b" 'eos::clear-at)
  745.  
  746.   (define-key eos::prefix-map "n" 'eos::next)
  747.   (define-key eos::prefix-map "s" 'eos::step)
  748.   (define-key eos::prefix-map "\C-s" 'eos::step-up)
  749.  
  750.   (define-key eos::prefix-map "u" 'eos::up)
  751.   (define-key eos::prefix-map "d" 'eos::down)
  752.  
  753. )
  754.  
  755. (defun eos::set-key-mode (mode)
  756.   ;; Set the key MODE to either 'none, 'prefix, or 'function
  757.   (setq eos::key-mode mode)
  758.   (cond
  759.    ((eq eos::key-mode 'none)
  760.     (define-key global-map "\C-cd" nil)
  761.     (eos::remove-function-keys)
  762.     (add-submenu nil (append '("SPARCworks") eos::short-menu))
  763.     )
  764.    ((eq eos::key-mode 'prefix)
  765.     (define-key global-map "\C-cd" eos::prefix-map)
  766.     (eos::remove-function-keys)
  767.     (add-submenu nil (append '("SPARCworks") eos::long-menu))
  768.     )
  769.    ((eq eos::key-mode 'function)
  770.     (define-key global-map "\C-cd" nil)
  771.     (eos::add-function-keys)
  772.     (add-submenu nil (append '("SPARCworks") eos::long-menu))
  773.     )
  774.    (t
  775.     (error "unimplemented")
  776.     )))
  777.  
  778. (defun eos::add-function-keys ()
  779.   (interactive)
  780.  
  781.   ;;
  782.   (global-set-key [f6] 'eos::dbx-cmd)
  783.   (global-set-key [(control f6)] 'eos::run)
  784.   (global-set-key [(shift f6)] 'eos::fix)
  785.   ;;
  786.   (global-set-key [f7] 'eos::print)
  787.   (global-set-key [(control f7)] 'eos::print*)
  788.   (global-set-key [(shift f7)] 'eos::dismiss-print-frame)
  789.   ;;
  790.   (global-set-key [f8] 'eos::cont)
  791.   (global-set-key [(control f8)] 'eos::stop-at)
  792.   (global-set-key [(shift f8)] 'eos::clear-at)
  793.   ;;
  794.   (global-set-key [f9] 'eos::next)
  795.   (global-set-key [(control f9)] 'eos::step)
  796.   (global-set-key [(shift f9)] 'eos::step-up)
  797.   ;;
  798.   )
  799.  
  800. (defun eos::remove-function-keys ()
  801.   (interactive)
  802.  
  803.   ;;
  804.   (global-set-key [f6] nil)
  805.   (global-set-key [(control f6)] nil)
  806.   (global-set-key [(shift f6)] nil)
  807.   ;;
  808.   (global-set-key [f7] nil)
  809.   (global-set-key [(control f7)] nil)
  810.   (global-set-key [(shift f7)] nil)
  811.   ;;
  812.   (global-set-key [f8] nil)
  813.   (global-set-key [(control f8)] nil)
  814.   (global-set-key [(shift f8)] nil)
  815.   ;;
  816.   (global-set-key [f9] nil)
  817.   (global-set-key [(control f9)] nil)
  818.   (global-set-key [(shift f9)] nil)
  819.   ;;
  820.   )
  821.  
  822. ;; Provides popup access
  823.  
  824. (defvar eos::popup-mode nil)
  825. (defvar eos::saved-global-popup-menu nil)
  826.  
  827. (defun eos::toggle-popup-menu ()
  828.   ;; Toggle whether to use or not popup menus for SPARCworks
  829.   (interactive)
  830.   (if eos::popup-mode
  831.       (setq global-popup-menu eos::saved-global-popup-menu)
  832.     (eos::push-popup-menu))
  833.   (setq eos::popup-mode (null eos::popup-mode))
  834.   )
  835.  
  836. (defun eos::push-popup-menu ()
  837.   (setq eos::saved-global-popup-menu global-popup-menu)
  838.   (setq global-popup-menu
  839.     (append
  840.      '("SPARCworks Command"
  841.        ["Stop At" eos::stop-at t]
  842.        ["Clear At" eos::clear-at t]
  843.        ["Stop In" eos::stop-in t]
  844.        ["Cont To" eos::cont-to t]
  845.        ["Print" eos::print t]
  846.        ["Print*" eos::print* t]
  847.        "---"
  848.        ["Read a Dbx Command" eos::dbx-cmd t]
  849.        "---")
  850.      (list
  851.       eos::saved-global-popup-menu))
  852.     ))
  853.  
  854. (provide 'eos-debugger)
  855.  
  856. ;;; sun-eos-debugger.el ends here
  857.